home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src / tclXlib.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-05  |  41.7 KB  |  1,420 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCLExtend_2
  3. #endif
  4. /*
  5.  * tclXlib.c --
  6.  *
  7.  * Tcl commands to load libraries of Tcl code.
  8.  *-----------------------------------------------------------------------------
  9.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  10.  *
  11.  * Permission to use, copy, modify, and distribute this software and its
  12.  * documentation for any purpose and without fee is hereby granted, provided
  13.  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  14.  * Mark Diekhans make no representations about the suitability of this
  15.  * software for any purpose.  It is provided "as is" without express or
  16.  * implied warranty.
  17.  *-----------------------------------------------------------------------------
  18.  * $Id: tclXlib.c,v 2.9 1993/07/30 15:05:15 markd Exp $
  19.  *-----------------------------------------------------------------------------
  20.  */
  21.  
  22. /*-----------------------------------------------------------------------------
  23.  * The Extended Tcl library code is a super set of the standard Tcl libaries.
  24.  * 
  25.  * The following data structures are kept as Tcl variables so they can be
  26.  * accessed from Tcl:
  27.  *
  28.  *   o auto_index - An array indexed by command name and contains code to
  29.  *     execute to make the command available.  Normally contains either:
  30.  *       "source file"
  31.  *       "auto_pkg_load package"
  32.  *   o auto_pkg_index - Indexed by package name.
  33.  *-----------------------------------------------------------------------------
  34.  */
  35. #include "tclExtdInt.h"
  36.  
  37. #ifdef macintosh
  38. #    include <types.h>
  39. #    include <files.h>
  40. #    include <errors.h>
  41. #endif
  42.  
  43. /*
  44.  * Names of Tcl variables that are used.
  45.  */
  46. static char *AUTO_INDEX     = "auto_index";
  47. static char *AUTO_PATH      = "auto_path";
  48. static char *AUTO_PKG_INDEX = "auto_pkg_index";
  49.  
  50. /*
  51.  * Per-interpreter structure used for managing the library.
  52.  */
  53. typedef struct libInfo_t {
  54.     Tcl_HashTable inProgressTbl;     /* List of cmds being loaded.       */
  55.     int           doingIdxSearch;    /* Loading indexes on a path now.   */
  56.     Tcl_DString   prevPath;          /* Previous path that was searched. */
  57. } libInfo_t;
  58.  
  59. /*
  60.  * Prototypes of internal functions.
  61.  */
  62. static int
  63. GlobalEvalFile _ANSI_ARGS_((Tcl_Interp *interp,
  64.                             char       *file));
  65.  
  66. static int
  67. EvalFilePart _ANSI_ARGS_((Tcl_Interp  *interp,
  68.                           char        *fileName,
  69.                           long         offset,
  70.                           unsigned     length));
  71.  
  72. static char *
  73. MakeAbsFile _ANSI_ARGS_((Tcl_Interp  *interp,
  74.                          char        *fileName,
  75.                          Tcl_DString *absNamePtr));
  76.  
  77. static int
  78. SetPackageIndexEntry _ANSI_ARGS_((Tcl_Interp *interp,
  79.                                   char       *packageName,
  80.                                   char       *fileName,
  81.                                   char       *offset,
  82.                                   char       *length,
  83.                                   int         overwrite));
  84.  
  85. static int
  86. GetPackageIndexEntry _ANSI_ARGS_((Tcl_Interp *interp,
  87.                                   char       *packageName,
  88.                                   char      **fileNamePtr,
  89.                                   long       *offsetPtr,
  90.                                   unsigned   *lengthPtr));
  91.  
  92. static int
  93. SetProcIndexEntry _ANSI_ARGS_((Tcl_Interp *interp,
  94.                                char       *procName,
  95.                                char       *package));
  96.  
  97. static void
  98. AddLibIndexErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
  99.                                   char       *indexName));
  100.  
  101. static int
  102. ProcessIndexFile _ANSI_ARGS_((Tcl_Interp *interp,
  103.                               char       *tlibFilePath,
  104.                               char       *tndxFilePath,
  105.                               int         overwrite));
  106.  
  107. static int
  108. BuildPackageIndex  _ANSI_ARGS_((Tcl_Interp *interp,
  109.                                 char       *tlibFilePath));
  110.  
  111. static int
  112. LoadPackageIndex _ANSI_ARGS_((Tcl_Interp *interp,
  113.                               char       *tlibFilePath,
  114.                               int         overwrite));
  115.  
  116. static int
  117. LoadOusterIndex _ANSI_ARGS_((Tcl_Interp *interp,
  118.                              char       *indexFilePath));
  119.  
  120. static int
  121. LoadDirIndexes _ANSI_ARGS_((Tcl_Interp  *interp,
  122.                             char        *dirName));
  123.  
  124. static int
  125. LoadPackageIndexes _ANSI_ARGS_((Tcl_Interp  *interp,
  126.                                 libInfo_t   *infoPtr,
  127.                                 char        *path));
  128.  
  129. static int
  130. AddInProgress _ANSI_ARGS_((Tcl_Interp  *interp,
  131.                            libInfo_t   *infoPtr,
  132.                            char        *command));
  133.  
  134. static void
  135. RemoveInProgress _ANSI_ARGS_((Tcl_Interp  *interp,
  136.                               libInfo_t   *infoPtr,
  137.                               char        *command));
  138.  
  139. static int
  140. LoadAutoPath _ANSI_ARGS_((Tcl_Interp  *interp,
  141.                           libInfo_t   *infoPtr));
  142.  
  143. static int
  144. LoadCommand _ANSI_ARGS_((Tcl_Interp  *interp,
  145.                          char        *command));
  146.  
  147. static void
  148. TclLibCleanUp _ANSI_ARGS_((ClientData  clientData,
  149.                            Tcl_Interp *interp));
  150.  
  151. /*
  152.  *-----------------------------------------------------------------------------
  153.  * GlobalEvalFile --
  154.  *
  155.  *  Evaluate a file at global level in an interpreter.
  156.  *-----------------------------------------------------------------------------
  157.  */
  158. static int
  159. GlobalEvalFile(interp, file)
  160.     Tcl_Interp *interp;
  161.     char       *file;
  162. {
  163.     register Interp *iPtr = (Interp *) interp;
  164.     int result;
  165.     CallFrame *savedVarFramePtr;
  166.  
  167.     savedVarFramePtr = iPtr->varFramePtr;
  168.     iPtr->varFramePtr = NULL;
  169.     result = Tcl_EvalFile (interp, file);
  170.     iPtr->varFramePtr = savedVarFramePtr;
  171.     return result;
  172. }
  173.  
  174. /*
  175.  *-----------------------------------------------------------------------------
  176.  * EvalFilePart --
  177.  *
  178.  *   Read in a byte range of a file and evaulate it.
  179.  *
  180.  * Parameters:
  181.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  182.  *   o fileName (I) - The file to evaulate.
  183.  *   o offset (I) - Byte offset into the file of the area to evaluate
  184.  *   o length (I) - Number of bytes to evaulate..
  185.  *-----------------------------------------------------------------------------
  186.  */
  187. static int
  188. EvalFilePart (interp, fileName, offset, length)
  189.     Tcl_Interp  *interp;
  190.     char        *fileName;
  191.     long         offset;
  192.     unsigned     length;
  193. {
  194.     Interp       *iPtr = (Interp *) interp;
  195.     int           fileNum, result;
  196.     struct stat   statBuf;
  197.     char         *oldScriptFile, *cmdBuffer, *buf;
  198.     Tcl_DString   tildeBuf;
  199.  
  200.     Tcl_DStringInit (&tildeBuf);
  201.     
  202.     if (fileName [0] == '~') {
  203.         if ((fileName = Tcl_TildeSubst (interp, fileName, &tildeBuf)) == NULL)
  204.             return TCL_ERROR;
  205.     }
  206.  
  207.     fileNum = open (fileName, O_RDONLY, 0);
  208.     if (fileNum < 0) {
  209.         Tcl_AppendResult (interp, "open failed on: ", fileName, ": ",
  210.                           Tcl_PosixError (interp), (char *) NULL);
  211.         return TCL_ERROR;
  212.     }
  213.  
  214.     if (fstat (fileNum, &statBuf) == -1)
  215.         goto accessError;
  216.  
  217.     if ((statBuf.st_size < offset + length) || (offset < 0)) {
  218.         Tcl_AppendResult (interp, "range to eval outside of file bounds \"",
  219.                           fileName, "\"", (char *) NULL);
  220.         goto errorExit;
  221.     }
  222.     if (lseek (fileNum, offset, 0) < 0)
  223.         goto accessError;
  224.  
  225.     cmdBuffer = ckalloc (length + 1);
  226.     if (read (fileNum, cmdBuffer, length) != length)
  227.         goto accessError;
  228.  
  229.     cmdBuffer [length] = '\0';
  230.  
  231.     if (close (fileNum) != 0)
  232.         goto accessError;
  233.     fileNum = -1;
  234.  
  235.     oldScriptFile = iPtr->scriptFile;
  236.     iPtr->scriptFile = fileName;
  237.  
  238.     result = Tcl_GlobalEval (interp, cmdBuffer);
  239.  
  240.     iPtr->scriptFile = oldScriptFile;
  241.     ckfree (cmdBuffer);
  242.                          
  243.     if (result != TCL_ERROR) {
  244.         Tcl_DStringFree (&tildeBuf);
  245.         return TCL_OK;
  246.     }
  247.  
  248.     /*
  249.      * An error occured in the command, record information telling where it
  250.      * came from.
  251.      */
  252.     buf = ckalloc (sizeof (fileName) + 64);
  253.     sprintf (buf, "\n    (file \"%s\" line %d)", fileName,
  254.              interp->errorLine);
  255.     Tcl_AddErrorInfo (interp, buf);
  256.     ckfree (buf);
  257.     goto errorExit;
  258.  
  259.     /*
  260.      * Errors accessing the file once its opened are handled here.
  261.      */
  262.   accessError:
  263.     Tcl_AppendResult (interp, "error accessing: ", fileName, ": ",
  264.                       Tcl_PosixError (interp), (char *) NULL);
  265.  
  266.   errorExit:
  267.     if (fileNum > 0)
  268.         close (fileNum);
  269.     Tcl_DStringFree (&tildeBuf);
  270.     return TCL_ERROR;
  271. }
  272.  
  273. /*
  274.  *-----------------------------------------------------------------------------
  275.  * MakeAbsFile --
  276.  *
  277.  * Convert a file name to an absolute path.  This handles tilde substitution
  278.  * and preappend the current directory name if the path is relative.
  279.  *
  280.  * Parameters
  281.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  282.  *   o fileName (I) - File name (should not start with a "/").
  283.  *   o absNamePtr (O) - The name is returned in this dynamic string.
  284.  * Returns:
  285.  *   A pointer to the file name in the dynamic string or NULL if an error
  286.  * occured.
  287.  *-----------------------------------------------------------------------------
  288.  */
  289. static char *
  290. MakeAbsFile (interp, fileName, absNamePtr)
  291.     Tcl_Interp  *interp;
  292.     char        *fileName;
  293.     Tcl_DString *absNamePtr;
  294.     {
  295.     char  curDir [MAXPATHLEN+1];
  296.  
  297.     Tcl_DStringFree (absNamePtr);
  298.  
  299.     /*
  300.      * If its already absolute, just copy the name.
  301.      */
  302. #ifdef macintosh
  303.     if (fileName [0] != ':') {
  304. #else
  305.     if (fileName [0] == '/') {
  306. #endif
  307.         Tcl_DStringAppend (absNamePtr, fileName, -1);
  308.         return Tcl_DStringValue (absNamePtr);
  309.     }
  310.  
  311.     /*
  312.      * If it starts with a tilde, the substitution will make it
  313.      * absolute.
  314.      */
  315.     if (fileName [0] == '~') {
  316.         if (Tcl_TildeSubst (interp, fileName, absNamePtr) == NULL)
  317.             return NULL;
  318.         return Tcl_DStringValue (absNamePtr);
  319.     }
  320.  
  321.     /*
  322.      * Otherwise its relative to the current directory, get the directory
  323.      * and go from here.
  324.      */
  325. #ifdef macintosh
  326.     {
  327.     WDPBRec    wpb;
  328.     Str32    vname;
  329.     
  330.     wpb.ioCompletion = 0;
  331.     wpb.ioNamePtr = vname;
  332.     PBHGetVol( &wpb, (Boolean)0 );
  333.     if (wpb.ioResult != noErr)
  334.         wpb.ioWDDirID = wpb.ioWDVRefNum = 0;
  335.     
  336.     dirpathname(curDir, wpb.ioWDVRefNum, wpb.ioWDDirID);
  337.     if (*curDir == '\0')
  338.         {
  339.         Tcl_AppendResult( interp, "error getting working directory name: ",
  340.                             curDir, (char *) NULL );
  341.         }
  342.     }
  343. #else
  344. #ifdef HAVE_GETCWD
  345.     if (getcwd (curDir, MAXPATHLEN) == NULL) {
  346.         Tcl_AppendResult (interp, "error getting working directory name: ",
  347.                           Tcl_PosixError (interp), (char *) NULL);
  348.     }
  349. #else
  350.     if (getwd (curDir) == NULL) {
  351.         Tcl_AppendResult (interp, "error getting working directory name: ",
  352.                           curDir, (char *) NULL);
  353.     }
  354. #endif
  355. #endif
  356.  
  357.     Tcl_DStringAppend (absNamePtr, curDir, -  1);
  358.     
  359. #ifdef macintosh
  360.     if ( absNamePtr->string[ absNamePtr->length-1 ] != ':' )
  361.         Tcl_DStringAppend (absNamePtr, ":",      -1);
  362. #else
  363.     Tcl_DStringAppend (absNamePtr, "/",      -1);
  364. #endif
  365.     Tcl_DStringAppend (absNamePtr, fileName, -1);
  366.  
  367.     return Tcl_DStringValue (absNamePtr);
  368. }
  369.  
  370. /*
  371.  *-----------------------------------------------------------------------------
  372.  * SetPackageIndexEntry --
  373.  *
  374.  * Set a package entry in the auto_pkg_index array in the form:
  375.  *
  376.  *     auto_pkg_index($packageName) [list $filename $offset $length]
  377.  *
  378.  * Duplicate package names are rejected unless overwrite is TRUE.
  379.  *
  380.  * Parameters
  381.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  382.  *   o packageName (I) - Package name.
  383.  *   o fileName (I) - Absolute file name of the file containing the package.
  384.  *   o offset (I) - String containing the numeric start of the package.
  385.  *   o length (I) - String containing the numeric length of the package.
  386.  *   o overwrite (I) - If TRUE, then overwrite existing definitions of the
  387.  *     package, if FALSE, reject this package if its a duplicate.
  388.  * Returns:
  389.  *   TCL_OK, TCL_ERROR or TCL_CONTINUE if the package name is already defined
  390.  * and is not to be overwritten.
  391.  *-----------------------------------------------------------------------------
  392.  */
  393. static int
  394. SetPackageIndexEntry (interp, packageName, fileName, offset, length, overwrite)
  395.      Tcl_Interp *interp;
  396.      char       *packageName;
  397.      char       *fileName;
  398.      char       *offset;
  399.      char       *length;
  400.      int         overwrite;
  401. {
  402.     char *pkgDataArgv [3], *dataStr, *setResult;
  403.  
  404.     /*
  405.      * If overwrite is not specified, check if the package alreay is defined.
  406.      */
  407.     if ((!overwrite) && (Tcl_GetVar2 (interp, AUTO_PKG_INDEX, packageName,
  408.                                       TCL_GLOBAL_ONLY) != NULL))
  409.         return TCL_CONTINUE;
  410.  
  411.     /*
  412.      * Build up the list of values to save.
  413.      */
  414.     pkgDataArgv [0] = fileName;
  415.     pkgDataArgv [1] = offset;
  416.     pkgDataArgv [2] = length;
  417.     dataStr = Tcl_Merge (3, pkgDataArgv);
  418.  
  419.     setResult = Tcl_SetVar2 (interp, AUTO_PKG_INDEX, packageName, dataStr,
  420.                              TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
  421.     ckfree (dataStr);
  422.  
  423.     return (setResult == NULL) ? TCL_ERROR : TCL_OK;
  424. }
  425.  
  426. /*
  427.  *-----------------------------------------------------------------------------
  428.  * GetPackageIndexEntry --
  429.  *
  430.  * Get a package entry from the auto_pkg_index array.
  431.  *
  432.  * Parameters
  433.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  434.  *   o packageName (I) - Package name to find.
  435.  *   o fileNamePtr (O) - The file name for the library file is returned here.
  436.  *     This should be freed by the caller.
  437.  *   o offsetPtr (O) - Start of the package in the library.
  438.  *   o lengthPtr (O) - Length of the package in the library.
  439.  * Returns:
  440.  *   TCL_OK or TCL_ERROR.
  441.  *-----------------------------------------------------------------------------
  442.  */
  443. static int
  444. GetPackageIndexEntry (interp, packageName, fileNamePtr, offsetPtr, lengthPtr)
  445.      Tcl_Interp *interp;
  446.      char       *packageName;
  447.      char      **fileNamePtr;
  448.      long       *offsetPtr;
  449.      unsigned   *lengthPtr;
  450. {
  451.     int   pkgDataArgc, idx;
  452.     char *dataStr, **pkgDataArgv = NULL;
  453.     char *srcPtr, *destPtr;
  454.  
  455.     /*
  456.      * Look up the package entry in the array.
  457.      */
  458.     dataStr = Tcl_GetVar2 (interp, AUTO_PKG_INDEX, packageName,
  459.                            TCL_GLOBAL_ONLY);
  460.     if (dataStr == NULL) {
  461.         Tcl_AppendResult (interp, "entry not found in \"auto_pkg_index \"",
  462.                           "for package \"", packageName, "\"", (char *) NULL);
  463.         return TCL_ERROR;
  464.     }
  465.  
  466.     /*
  467.      * Extract the data from the array entry.  The file name will be copied
  468.      * to the top of the memory area returned by Tcl_SplitList after the
  469.      * other fields have been accessed.  Copied in a way allowing for overlap.
  470.      */
  471.     if (Tcl_SplitList (interp, dataStr, &pkgDataArgc, &pkgDataArgv) != TCL_OK)
  472.         goto invalidEntry;
  473.     if (pkgDataArgc != 3)
  474.         goto invalidEntry;
  475.  
  476.     if (!Tcl_StrToLong (pkgDataArgv [1], 0, offsetPtr))
  477.         goto invalidEntry;
  478.     if (!Tcl_StrToUnsigned (pkgDataArgv [2], 0, lengthPtr))
  479.         goto invalidEntry;
  480.  
  481.     *fileNamePtr = destPtr = (char *) pkgDataArgv;
  482.     srcPtr = pkgDataArgv [0];
  483.  
  484.     while (*srcPtr != '\0') {
  485.         *destPtr++ = *srcPtr++;
  486.     }
  487.     *destPtr = '\0';
  488.  
  489.     return TCL_OK;
  490.     
  491.     /*
  492.      * Exit point when an invalid entry is found.
  493.      */
  494.   invalidEntry:
  495.     if (pkgDataArgv != NULL)
  496.         ckfree (pkgDataArgv);
  497.     Tcl_ResetResult (interp);
  498.     Tcl_AppendResult (interp, "invalid entry in \"auto_pkg_index \"",
  499.                       "for package \"", packageName, "\"", (char *) NULL);
  500.     return TCL_ERROR;
  501. }
  502.  
  503. /*
  504.  *-----------------------------------------------------------------------------
  505.  * SetProcIndexEntry --
  506.  *
  507.  * Set the proc entry in the auto_index array.  These entry contains a command
  508.  * to make the proc available from a package.
  509.  *
  510.  * Parameters
  511.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  512.  *   o procName (I) - The Tcl proc name.
  513.  *   o package (I) - Pacakge containing the proc.
  514.  * Returns:
  515.  *   TCL_OK or TCL_ERROR.
  516.  *-----------------------------------------------------------------------------
  517.  */
  518. static int
  519. SetProcIndexEntry (interp, procName, package)
  520.     Tcl_Interp *interp;
  521.     char       *procName;
  522.     char       *package;
  523. {
  524.     Tcl_DString  command;
  525.     char        *result;
  526.  
  527.     Tcl_DStringInit (&command);
  528.     Tcl_DStringAppend (&command, "auto_load_pkg {", -1);
  529.     Tcl_DStringAppend (&command, package, -1);
  530.     Tcl_DStringAppend (&command, "}", -1);
  531.  
  532.     result = Tcl_SetVar2 (interp, AUTO_INDEX, procName, command.string,
  533.                           TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
  534.  
  535.     Tcl_DStringFree (&command);
  536.  
  537.     return (result == NULL) ? TCL_ERROR : TCL_OK;
  538. }
  539.  
  540. /*
  541.  *-----------------------------------------------------------------------------
  542.  * AddLibIndexErrorInfo --
  543.  *
  544.  * Add information to the error info stack about index that just failed.
  545.  * This is generic for both tclIndex and .tlib indexs
  546.  *
  547.  * Parameters
  548.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  549.  *   o indexName (I) - The name of the index.
  550.  *-----------------------------------------------------------------------------
  551.  */
  552. static void
  553. AddLibIndexErrorInfo (interp, indexName)
  554.     Tcl_Interp *interp;
  555.     char       *indexName;
  556. {
  557.     char *msg;
  558.  
  559.     msg = ckalloc (strlen (indexName) + 60);
  560.     strcpy (msg, "\n    while loading Tcl library index \"");
  561.     strcat (msg, indexName);
  562.     strcat (msg, "\"");
  563.     Tcl_AddErrorInfo (interp, msg);
  564.     ckfree (msg);
  565. }
  566.  
  567.  
  568. /*
  569.  *-----------------------------------------------------------------------------
  570.  * ProcessIndexFile --
  571.  *
  572.  * Open and process a package library index file (.tndx).  Creates entries
  573.  * in the auto_index and auto_pkg_index arrays.   If the package is already
  574.  * defined it skipped unless overwrite is TRUE.
  575.  *
  576.  * Parameters
  577.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  578.  *   o tlibFilePath (I) - Absolute path name to the library file.
  579.  *   o tndxFilePath (I) - Absolute path name to the library file index.
  580.  *   o overwrite (I) - If TRUE, then overwrite existing definitions of
  581.  *     packages, if FALSE, skip packages that are duplicate.
  582.  * Returns:
  583.  *   TCL_OK or TCL_ERROR.
  584.  *-----------------------------------------------------------------------------
  585.  */
  586. static int
  587. ProcessIndexFile (interp, tlibFilePath, tndxFilePath, overwrite)
  588.      Tcl_Interp *interp;
  589.      char       *tlibFilePath;
  590.      char       *tndxFilePath;
  591.      int         overwrite;
  592. {
  593.     FILE        *indexFilePtr = NULL;
  594.     Tcl_DString  lineBuffer;
  595.     int          lineArgc, idx, result, status;
  596.     char       **lineArgv = NULL;
  597.  
  598.     indexFilePtr = fopen (tndxFilePath, "r");
  599.     if (indexFilePtr == NULL)
  600.         goto fileError;
  601.     
  602.     Tcl_DStringInit (&lineBuffer);
  603.  
  604.     while (TRUE) {
  605.         Tcl_DStringFree (&lineBuffer);
  606.         status = Tcl_DStringGets (indexFilePtr, &lineBuffer);
  607.         if (status == TCL_BREAK)
  608.             goto reachedEOF;
  609.         if (status == TCL_ERROR)
  610.             goto fileError;
  611.  
  612.         if ((Tcl_SplitList (interp, lineBuffer.string, &lineArgc,
  613.                             &lineArgv) != TCL_OK) || (lineArgc < 4))
  614.             goto formatError;
  615.         
  616.         /*
  617.          * lineArgv [0] is the package name.
  618.          * lineArgv [1] is the package offset in the library.
  619.          * lineArgv [2] is the package length in the library.
  620.          * lineArgv [3-n] are the entry procedures for the package.
  621.          */
  622.         result = SetPackageIndexEntry (interp, lineArgv [0], tlibFilePath,
  623.                                        lineArgv [1], lineArgv [2], overwrite);
  624.         if (result == TCL_ERROR)
  625.             goto errorExit;
  626.  
  627.         /*
  628.          * If the package is not duplicated, add the commands to load
  629.          * the procedures.
  630.          */
  631.         if (result != TCL_CONTINUE) {
  632.             for (idx = 3; idx < lineArgc; idx++) {
  633.                 if (SetProcIndexEntry (interp, lineArgv [idx],
  634.                                        lineArgv [0]) != TCL_OK)
  635.                     goto errorExit;
  636.             }
  637.         }
  638.         ckfree (lineArgv);
  639.         lineArgv = NULL;
  640.     }
  641.  
  642.   reachedEOF:
  643.     fclose (indexFilePtr);
  644.     Tcl_DStringFree (&lineBuffer);
  645.  
  646.     return TCL_OK;
  647.  
  648.     /*
  649.      * Handle format error in library input line.
  650.      */
  651.   formatError:
  652.     Tcl_ResetResult (interp);
  653.     Tcl_AppendResult (interp, "format error in library index \"",
  654.                       tndxFilePath, "\" (", lineBuffer.string, ")",
  655.                       (char *) NULL);
  656.     goto errorExit;
  657.  
  658.  
  659.   fileError:
  660.     Tcl_AppendResult (interp, "error accessing package index file \"",
  661.                       tndxFilePath, "\": ", Tcl_PosixError (interp),
  662.                       (char *) NULL);
  663.     goto errorExit;
  664.  
  665.     /*
  666.      * Error exit here, releasing resources and closing the file.
  667.      */
  668.   errorExit:
  669.     if (lineArgv != NULL)
  670.         ckfree (lineArgv);
  671.     Tcl_DStringFree (&lineBuffer);
  672.     if (indexFilePtr != NULL)
  673.         fclose (indexFilePtr);
  674.     return TCL_ERROR;
  675. }
  676.  
  677. /*
  678.  *-----------------------------------------------------------------------------
  679.  * BuildPackageIndex --
  680.  *
  681.  * Call the "buildpackageindex" Tcl procedure to rebuild a package index.
  682.  * This is found with the [info library] command.
  683.  *
  684.  * Parameters
  685.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  686.  *   o tlibFilePath (I) - Absolute path name to the library file.
  687.  * Returns:
  688.  *   TCL_OK or TCL_ERROR.
  689.  *
  690.  * ????Change name to auto something.
  691.  *-----------------------------------------------------------------------------
  692.  */
  693. static int
  694. BuildPackageIndex (interp, tlibFilePath)
  695.      Tcl_Interp *interp;
  696.      char       *tlibFilePath;
  697. {
  698.     Tcl_DString  command;
  699.     int          result;
  700.  
  701.     Tcl_DStringInit (&command);
  702.  
  703. #ifdef macintosh
  704.     Tcl_DStringAppend (&command, "source [info library]:buildidx.tcl;", -1);
  705. #else
  706.     Tcl_DStringAppend (&command, "source [info library]/buildidx.tcl;", -1);
  707. #endif
  708.     Tcl_DStringAppend (&command, "buildpackageindex ", -1);
  709.     Tcl_DStringAppend (&command, tlibFilePath, -1);
  710.  
  711.     result = Tcl_GlobalEval (interp, command.string);
  712.  
  713.     Tcl_DStringFree (&command);
  714.  
  715.     if (result == TCL_ERROR)
  716.         return TCL_ERROR;
  717.     Tcl_ResetResult (interp);
  718.     return result;
  719. }
  720.  
  721. /*
  722.  *-----------------------------------------------------------------------------
  723.  * LoadPackageIndex --
  724.  *
  725.  * Load a package .tndx file.  Rebuild .tlib if non-existant or out of
  726.  * date.
  727.  *
  728.  * Parameters
  729.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  730.  *   o tlibFilePath (I) - Absolute path name to the library file.
  731.  *   o overwrite (I) - If TRUE, then overwrite existing definitions of
  732.  *     packages, if FALSE, skip packages that are duplicate.
  733.  * Returns:
  734.  *   TCL_OK or TCL_ERROR.
  735.  *-----------------------------------------------------------------------------
  736.  */
  737. static int
  738. LoadPackageIndex (interp, tlibFilePath, overwrite)
  739.      Tcl_Interp *interp;
  740.      char       *tlibFilePath;
  741.      int         overwrite;
  742. {
  743.     Tcl_DString  tndxFilePath;
  744.     struct stat  tlibStat;
  745.     struct stat  tndxStat;
  746.  
  747.     Tcl_DStringInit (&tndxFilePath);
  748.  
  749.     Tcl_DStringAppend (&tndxFilePath, tlibFilePath, -1);
  750.     tndxFilePath.string [tndxFilePath.length - 3] = 'n';
  751.     tndxFilePath.string [tndxFilePath.length - 2] = 'd';
  752.     tndxFilePath.string [tndxFilePath.length - 1] = 'x';
  753.  
  754.     /*
  755.      * Get library's modification time.  If the file can't be accessed, set
  756.      * time so the library does not get built.  Other code will report the
  757.      * error.
  758.      */
  759.     if (stat (tlibFilePath, &tlibStat) < 0)
  760.         tlibStat.st_mtime = MAXINT;
  761.  
  762.     /*
  763.      * Get the time for the index.  If the file does not exists or is
  764.      * out of date, rebuild it.
  765.      */
  766.     if ((stat (tndxFilePath.string, &tndxStat) < 0) ||
  767.         (tndxStat.st_mtime < tlibStat.st_mtime)) {
  768.         if (BuildPackageIndex (interp, tlibFilePath) != TCL_OK)
  769.             goto errorExit;
  770.     }
  771.  
  772.     if (ProcessIndexFile (interp, tlibFilePath, tndxFilePath.string,
  773.                           overwrite) != TCL_OK)
  774.         goto errorExit;
  775.     Tcl_DStringFree (&tndxFilePath);
  776.     return TCL_OK;
  777.  
  778.   errorExit:
  779.     AddLibIndexErrorInfo (interp, tndxFilePath.string);
  780.     Tcl_DStringFree (&tndxFilePath);
  781.  
  782.     return TCL_ERROR;
  783. }
  784.  
  785. /*
  786.  *-----------------------------------------------------------------------------
  787.  * LoadOusterIndex --
  788.  *
  789.  * Load a standard Tcl index (tclIndex).  A special proc is used so that the
  790.  * "dir" variable can be set.
  791.  *
  792.  * Parameters
  793.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  794.  *   o indexFilePath (I) - Absolute path name to the tclIndex file.
  795.  * Returns:
  796.  *   TCL_OK or TCL_ERROR.
  797.  *-----------------------------------------------------------------------------
  798.  */
  799. static int
  800. LoadOusterIndex (interp, indexFilePath)
  801.      Tcl_Interp *interp;
  802.      char       *indexFilePath;
  803. {
  804.     Tcl_DString  command;
  805.     
  806.     Tcl_DStringInit (&command);
  807.     Tcl_DStringAppend (&command, "set auto_index(auto_load_ouster_index) ",
  808.                        -1);
  809. #ifdef macintosh
  810.     Tcl_DStringAppend (&command, "\"source [info library]:loadouster.tcl\";",
  811.                        -1);
  812. #else
  813.     Tcl_DStringAppend (&command, "\"source [info library]/loadouster.tcl\";",
  814.                        -1);
  815. #endif
  816.     Tcl_DStringAppend (&command, "auto_load_ouster_index {", -1);
  817.     Tcl_DStringAppend (&command, indexFilePath, -1);
  818.     Tcl_DStringAppend (&command, "}", -1);
  819.  
  820.     if (Tcl_GlobalEval (interp, command.string) == TCL_ERROR) {
  821.         AddLibIndexErrorInfo (interp, indexFilePath);
  822.         Tcl_DStringFree (&command);
  823.         return TCL_ERROR;
  824.     }
  825.     Tcl_DStringFree (&command);
  826.     Tcl_ResetResult (interp);
  827.     return TCL_OK;
  828. }
  829.  
  830. /*
  831.  *-----------------------------------------------------------------------------
  832.  * LoadDirIndexes --
  833.  *
  834.  *     Load the indexes for all package library (.tlib) or a Ousterhout
  835.  *  "tclIndex" file in a directory.  Nonexistent or unreadable directories
  836.  *  are skipped.
  837.  *
  838.  * Parameters
  839.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  840.  *   o dirName (I) - The absolute path name of the directory to search for
  841.  *     libraries.
  842.  *-----------------------------------------------------------------------------
  843.  */
  844. static int
  845. LoadDirIndexes (interp, dirName)
  846.     Tcl_Interp  *interp;
  847.     char        *dirName;
  848. {
  849. #ifdef macintosh
  850.     int                index, result;
  851.     Str32            mac_name;
  852.     CInfoPBRec        cpb;
  853.     struct stat        statbuf;
  854. #else
  855.     DIR           *dirPtr;
  856.     struct dirent *entryPtr;
  857. #endif
  858.     int            dirNameLen, nameLen;
  859.     Tcl_DString    filePath;
  860.  
  861. #ifdef macintosh
  862.     if ( stat(dirName, &statbuf ) < 0 )
  863.         return TCL_OK;
  864. #else
  865.     dirPtr = opendir (dirName);
  866.     if (dirPtr == NULL)
  867.         return TCL_OK;   /* Skip directory */
  868. #endif
  869.  
  870.     Tcl_DStringInit (&filePath);
  871.     Tcl_DStringAppend (&filePath, dirName, -1);
  872. #ifdef macintosh
  873.     if ( filePath.string[ filePath.length-1 ] != ':' )
  874.         Tcl_DStringAppend (&filePath, ":",     -1);
  875. #else
  876.     Tcl_DStringAppend (&filePath, "/",     -1);
  877. #endif
  878.  
  879.     dirNameLen = filePath.length /* *TGE* strlen (dirName) + 1 */;
  880.  
  881. #ifdef macintosh
  882.     for ( index = 1 ; ; ++index )
  883. #else
  884.     while (TRUE)
  885. #endif
  886.         {
  887. #ifdef macintosh
  888.         cpb.hFileInfo.ioCompletion = 0;
  889.         cpb.hFileInfo.ioVRefNum = statbuf.st_dev;
  890.         cpb.hFileInfo.ioNamePtr = mac_name; mac_name[0] = '\0';
  891.         cpb.hFileInfo.ioFDirIndex = index;
  892.         cpb.hFileInfo.ioDirID = statbuf.st_ino;
  893.         result = PBGetCatInfo(&cpb, FALSE);
  894.         if ( result != noErr )
  895.             break;
  896.         nameLen = mac_name[0];
  897.         p2cstr(mac_name);
  898. #else
  899.         entryPtr = readdir (dirPtr);
  900.         if (entryPtr == NULL)
  901.             break;
  902.         nameLen = strlen (entryPtr->d_name);
  903. #endif
  904.  
  905.         if ( (nameLen > 5) && 
  906. #ifdef macintosh
  907.                 ( ( STREQU((char *)mac_name + nameLen - 5, ".tlib") ) ||
  908.                     ( STREQU((char *)mac_name, "tclIndex") ) ) )
  909. #else
  910.                 ((STREQU (entryPtr->d_name + nameLen - 5, ".tlib")) ||
  911.                 (STREQU (entryPtr->d_name, "tclIndex"))))
  912. #endif
  913.             {
  914.             /*
  915.              * Append the file name on to the directory.
  916.              */
  917.             Tcl_DStringTrunc (&filePath, dirNameLen);
  918. #ifdef macintosh
  919.             Tcl_DStringAppend (&filePath, (char *)mac_name, -1);
  920. #else
  921.             Tcl_DStringAppend (&filePath, entryPtr->d_name, -1);
  922. #endif
  923.  
  924.             /*
  925.              * Skip index it can't be accessed.
  926.              */
  927.             if (access (filePath.string, R_OK) < 0)
  928.                 continue;
  929.  
  930.             /*
  931.              * Process the index according to its type.
  932.              */
  933. #ifdef macintosh
  934.             if (mac_name[ nameLen - 5 ] == '.')
  935. #else
  936.             if (entryPtr->d_name [nameLen - 5] == '.')
  937. #endif
  938.                 {
  939.                 if (LoadPackageIndex (interp, filePath.string, FALSE) != TCL_OK)
  940.                     goto errorExit;
  941.                 }
  942.             else
  943.                 {
  944.                 if (LoadOusterIndex (interp, filePath.string) != TCL_OK)
  945.                     goto errorExit;
  946.                 }
  947.             }
  948.         }
  949.  
  950.     Tcl_DStringFree (&filePath);
  951. #ifndef macintosh
  952.     closedir (dirPtr);
  953. #endif
  954.     return TCL_OK;
  955.  
  956.   errorExit:
  957.     Tcl_DStringFree (&filePath);
  958. #ifndef macintosh
  959.     closedir (dirPtr);
  960. #endif
  961.     return TCL_ERROR;
  962.     }
  963.  
  964. /*
  965.  *-----------------------------------------------------------------------------
  966.  * LoadPackageIndexes --
  967.  *
  968.  * Loads the all indexes for all package libraries (.tlib) or a
  969.  * Ousterhout "tclIndex" files found in all directories in the path.
  970.  * If an index has already been loaded, it will not be reloaded.
  971.  * Non-existent or unreadable directories are skipped.
  972.  * The Tcl array variables auto_index and auto_PKG_INDEX are updated.
  973.  *-----------------------------------------------------------------------------
  974.  */
  975. static int
  976. LoadPackageIndexes (interp, infoPtr, path)
  977.     Tcl_Interp  *interp;
  978.     libInfo_t   *infoPtr;
  979.     char        *path;
  980. {
  981.     char        *dirName;
  982.     Tcl_DString  dirNameBuf;
  983.     int          idx, pathArgc, result = TCL_OK;
  984.     char       **pathArgv;
  985.  
  986.     Tcl_DStringInit (&dirNameBuf);
  987.  
  988.     if (infoPtr->doingIdxSearch) {
  989.         Tcl_AppendResult (interp, "recursive load of indexes ",
  990.                           "(probable invalid command while loading index)",
  991.                           (char *) NULL);
  992.         return TCL_ERROR;
  993.     }
  994.     infoPtr->doingIdxSearch = TRUE;
  995.  
  996.     if (Tcl_SplitList (interp, path, &pathArgc, &pathArgv) != TCL_OK) {
  997.         infoPtr->doingIdxSearch = FALSE;
  998.         return TCL_ERROR;
  999.     }
  1000.  
  1001.     for (idx = 0; idx < pathArgc; idx++) {
  1002.         /*
  1003.          * Get the absolute dir name.  if the conversion fails (most likely
  1004.          * invalid "~") or the directory can't be read, skip it.
  1005.          */
  1006.         dirName = MakeAbsFile (interp, pathArgv [idx], &dirNameBuf);
  1007.         if (dirName == NULL)
  1008.             continue;
  1009.         
  1010.         if (access (dirName, X_OK) == 0)
  1011.             result = LoadDirIndexes (interp, dirName);
  1012.         else
  1013.             result = TCL_OK;
  1014.  
  1015.         Tcl_DStringFree (&dirNameBuf);
  1016.         if (result != TCL_OK)
  1017.             break;
  1018.     }
  1019.  
  1020.     ckfree (pathArgv);
  1021.     infoPtr->doingIdxSearch = FALSE;
  1022.     return result;
  1023. }
  1024.  
  1025. /*
  1026.  *-----------------------------------------------------------------------------
  1027.  * Tcl_Auto_load_pkgCmd --
  1028.  *
  1029.  *   Implements the command:
  1030.  *      auto_load_pkg package
  1031.  *
  1032.  * Which is called to load a .tlib package who's index has already been loaded.
  1033.  *-----------------------------------------------------------------------------
  1034.  */
  1035. static int
  1036. Tcl_Auto_load_pkgCmd (dummy, interp, argc, argv)
  1037.     ClientData   dummy;
  1038.     Tcl_Interp  *interp;
  1039.     int          argc;
  1040.     char       **argv;
  1041. {
  1042.     char     *fileName;
  1043.     long      offset;
  1044.     unsigned  length;
  1045.     int       result;
  1046.  
  1047.     if (argc != 2) {
  1048.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " package",
  1049.                           (char *) NULL);
  1050.         return TCL_ERROR;
  1051.     }
  1052.  
  1053.     if (GetPackageIndexEntry (interp, argv [1], &fileName, &offset,
  1054.                               &length) != TCL_OK)
  1055.         return TCL_ERROR;
  1056.  
  1057.     result = EvalFilePart (interp, fileName, offset, length);
  1058.     ckfree (fileName);
  1059.  
  1060.     return result;
  1061. }
  1062.  
  1063. /*
  1064.  *-----------------------------------------------------------------------------
  1065.  * AddInProgress --
  1066.  *
  1067.  *   An a command to the table of in progress commands.  If the command is
  1068.  * already in the table, return an error.
  1069.  *
  1070.  * Parameters
  1071.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  1072.  *   o infoPtr (I) - Interpreter specific library info.
  1073.  *   o command (I) - The command to add.
  1074.  * Returns:
  1075.  *   TCL_OK or TCL_ERROR.
  1076.  *-----------------------------------------------------------------------------
  1077.  */
  1078. static int
  1079. AddInProgress (interp, infoPtr, command)
  1080.     Tcl_Interp  *interp;
  1081.     libInfo_t   *infoPtr;
  1082.     char        *command;
  1083. {
  1084.     int  newEntry;
  1085.  
  1086.     Tcl_CreateHashEntry (&infoPtr->inProgressTbl, command, &newEntry);
  1087.  
  1088.     if (!newEntry) {
  1089.         Tcl_AppendResult (interp, "recursive auto_load of \"",
  1090.                           command, "\"", (char *) NULL);
  1091.         return TCL_ERROR;
  1092.     }
  1093.     return TCL_OK;
  1094. }
  1095.  
  1096. /*
  1097.  *-----------------------------------------------------------------------------
  1098.  * RemoveInProgress --
  1099.  *
  1100.  *   Remove a command from the in progress table.
  1101.  *
  1102.  * Parameters
  1103.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  1104.  *   o infoPtr (I) - Interpreter specific library info.
  1105.  *   o command (I) - The command to remove.
  1106.  *-----------------------------------------------------------------------------
  1107.  */
  1108. static void
  1109. RemoveInProgress (interp, infoPtr, command)
  1110.     Tcl_Interp  *interp;
  1111.     libInfo_t   *infoPtr;
  1112.     char        *command;
  1113. {
  1114.     Tcl_HashEntry *entryPtr;
  1115.  
  1116.     entryPtr = Tcl_FindHashEntry (&infoPtr->inProgressTbl, command);
  1117.     if (entryPtr == NULL)
  1118.         panic ("lost in-progress command");
  1119.  
  1120.     Tcl_DeleteHashEntry (entryPtr);
  1121. }
  1122.  
  1123. /*
  1124.  *-----------------------------------------------------------------------------
  1125.  * LoadAutoPath --
  1126.  *
  1127.  *   Load all indexs on the auto_path variable.  If auto_path has not changed
  1128.  * since the last time libraries were successfully loaded, this is a no-op.
  1129.  *
  1130.  * Parameters
  1131.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  1132.  *   o infoPtr (I) - Interpreter specific library info.
  1133.  * Returns:
  1134.  *   TCL_OK or TCL_ERROR
  1135.  *-----------------------------------------------------------------------------
  1136.  */
  1137. static int
  1138. LoadAutoPath (interp, infoPtr)
  1139.     Tcl_Interp  *interp;
  1140.     libInfo_t   *infoPtr;
  1141. {
  1142.     char  *path;
  1143.  
  1144.     path = Tcl_GetVar (interp, AUTO_PATH, TCL_GLOBAL_ONLY);
  1145.     if (path == NULL)
  1146.         return TCL_OK;
  1147.     
  1148.     /*
  1149.      * Check if the path has changed.  If it has, load indexes, and
  1150.      * save the path if it succeeds.
  1151.      */
  1152.     if (STREQU (path, infoPtr->prevPath.string))
  1153.         return TCL_OK;
  1154.  
  1155.     if (LoadPackageIndexes (interp, infoPtr, path) != TCL_OK)
  1156.         return TCL_ERROR;
  1157.  
  1158.     Tcl_DStringFree (&infoPtr->prevPath);
  1159.     Tcl_DStringAppend (&infoPtr->prevPath, path, -1);
  1160.     return TCL_OK;
  1161. }
  1162.  
  1163. /*
  1164.  *-----------------------------------------------------------------------------
  1165.  * LoadCommand --
  1166.  *
  1167.  *   Check the "auto_index" array for code to load a command and eval it.
  1168.  *
  1169.  * Parameters
  1170.  *   o interp (I) - A pointer to the interpreter, error returned in result.
  1171.  *   o command (I) - The command to load.
  1172.  * Returns:
  1173.  *   TCL_OK if the command was loaded.
  1174.  *   TCL_CONTINUE if the command is not in the index.
  1175.  *   TCL_ERROR if an error occured.
  1176.  *-----------------------------------------------------------------------------
  1177.  */
  1178. static int
  1179. LoadCommand (interp, command)
  1180.     Tcl_Interp  *interp;
  1181.     char        *command;
  1182. {
  1183.     char              *loadCmd;
  1184.     ClientData         clientData;
  1185.     Tcl_CmdDeleteProc *deleteProc;
  1186.     Tcl_CmdInfo        cmdInfo;
  1187.  
  1188.     loadCmd = Tcl_GetVar2 (interp, AUTO_INDEX, command, TCL_GLOBAL_ONLY);
  1189.     if (loadCmd == NULL)
  1190.         return TCL_CONTINUE;   /* Not found */
  1191.  
  1192.     if (Tcl_GlobalEval (interp, loadCmd) == TCL_ERROR)
  1193.         return TCL_ERROR;
  1194.     Tcl_ResetResult (interp);
  1195.  
  1196.     if (Tcl_GetCommandInfo (interp, command, &cmdInfo))
  1197.         return TCL_OK;  /* Found and loaded */
  1198.  
  1199.     Tcl_AppendResult (interp, "command \"", command, "\" was not loaded by ",
  1200.                       "\"", loadCmd, "\" even though it returned no error",
  1201.                       (char *) NULL);
  1202.     return TCL_ERROR;
  1203. }
  1204.  
  1205. /*
  1206.  *-----------------------------------------------------------------------------
  1207.  * Tcl_LoadlibindexCmd --
  1208.  *
  1209.  *   This procedure is invoked to process the "Loadlibindex" Tcl command:
  1210.  *
  1211.  *      loadlibindex libfile
  1212.  *
  1213.  * which loads the index for a package library (.tlib) or a Ousterhout
  1214.  * "tclIndex" file.  New package definitions will override existing ones.
  1215.  *-----------------------------------------------------------------------------
  1216.  */
  1217. static int
  1218. Tcl_LoadlibindexCmd (dummy, interp, argc, argv)
  1219.     ClientData   dummy;
  1220.     Tcl_Interp  *interp;
  1221.     int          argc;
  1222.     char       **argv;
  1223. {
  1224.     char        *pathName;
  1225.     Tcl_DString  pathNameBuf;
  1226.     int          pathLen;
  1227.  
  1228.     Tcl_DStringInit (&pathNameBuf);
  1229.  
  1230.     if (argc != 2) {
  1231.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " libFile",
  1232.                           (char *) NULL);
  1233.         return TCL_ERROR;
  1234.     }
  1235.  
  1236.     pathName = MakeAbsFile (interp, argv [1], &pathNameBuf);
  1237.     if (pathName == NULL)
  1238.         return TCL_ERROR;
  1239.  
  1240.     /*
  1241.      * Find the length of the directory name. Validate that we have a .tlib
  1242.      * extension or file name is "tclIndex" and call the routine to process
  1243.      * the specific type of index.
  1244.      */
  1245.     pathLen = strlen (pathName);
  1246.  
  1247.     if ((pathLen > 5) && (pathName [pathLen - 5] == '.')) {
  1248.         if (!STREQU (pathName + pathLen - 5, ".tlib"))
  1249.             goto invalidName;
  1250.         if (LoadPackageIndex (interp, pathName, TRUE) != TCL_OK)
  1251.             goto errorExit;
  1252.     } else {
  1253. #ifdef macintosh
  1254.         if (!STREQU (pathName + pathLen - 9, ":tclIndex"))
  1255. #else
  1256.         if (!STREQU (pathName + pathLen - 9, "/tclIndex"))
  1257. #endif
  1258.             goto invalidName;
  1259.         if (LoadOusterIndex (interp, pathName) != TCL_OK)
  1260.             goto errorExit;
  1261.     }
  1262.     Tcl_DStringFree (&pathNameBuf);
  1263.     return TCL_OK;
  1264.  
  1265.   invalidName:
  1266.     Tcl_AppendResult (interp, "invalid library name, must have an extension ",
  1267.                       "of \".tlib\" or the name \"tclIndex\", got \"",
  1268.                       argv [1], "\", ", "pathName \"", pathName, "\"", (char *) NULL);
  1269.  
  1270.   errorExit:
  1271.     Tcl_DStringFree (&pathNameBuf);
  1272.     return TCL_ERROR;;
  1273. }
  1274.  
  1275. /*
  1276.  *-----------------------------------------------------------------------------
  1277.  * Tcl_auto_loadCmd --
  1278.  *
  1279.  *   This procedure is invoked to process the "auto_load" Tcl command:
  1280.  *
  1281.  *         auto_load ?command?
  1282.  *
  1283.  * which searchs the auto_load tables for the specified procedure.  If it
  1284.  * is not found, an attempt is made to load unloaded library indexes by
  1285.  * searching auto_path.
  1286.  *-----------------------------------------------------------------------------
  1287.  */
  1288. static int
  1289. Tcl_Auto_loadCmd (clientData, interp, argc, argv)
  1290.     ClientData   clientData;
  1291.     Tcl_Interp  *interp;
  1292.     int          argc;
  1293.     char       **argv;
  1294. {
  1295.     libInfo_t *infoPtr = (libInfo_t *) clientData;
  1296.     int        result;
  1297.     char      *msg;
  1298.  
  1299.     if (argc > 2) {
  1300.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " ?command?",
  1301.                           (char *) NULL);
  1302.         return TCL_ERROR;
  1303.     }
  1304.  
  1305.     /*
  1306.      * If no command is specified, just load the indexs.
  1307.      */
  1308.     if (argc == 1)
  1309.         return LoadAutoPath (interp, infoPtr);
  1310.  
  1311.     /*
  1312.      * Do checking for recursive auto_load of the same command.
  1313.      */
  1314.     if (AddInProgress (interp, infoPtr, argv [1]) != TCL_OK)
  1315.         return TCL_ERROR;
  1316.  
  1317.     /*
  1318.      * First, attempt to load it from the indexes in memory.
  1319.      */
  1320.     result = LoadCommand (interp, argv [1]);
  1321.     if (result == TCL_ERROR)
  1322.         goto errorExit;
  1323.     if (result == TCL_OK)
  1324.         goto found;
  1325.     
  1326.     /*
  1327.      * Slow path, load the libraries indices on auto_path.
  1328.      */
  1329.     if (LoadAutoPath (interp, infoPtr) != TCL_OK)
  1330.         goto errorExit;
  1331.  
  1332.     /*
  1333.      * Try to load the command again.
  1334.      */
  1335.     result = LoadCommand (interp, argv [1]);
  1336.     if (result == TCL_ERROR)
  1337.         goto errorExit;
  1338.     if (result != TCL_OK)
  1339.         goto notFound;
  1340.  
  1341.   found:
  1342.     RemoveInProgress (interp, infoPtr, argv [1]);
  1343.     interp->result = "1";
  1344.     return TCL_OK;
  1345.  
  1346.   notFound:
  1347.     RemoveInProgress (interp, infoPtr, argv [1]);
  1348.     interp->result = "0";
  1349.     return TCL_OK;
  1350.  
  1351.   errorExit:
  1352.     msg = ckalloc (strlen (argv [1]) + 35);
  1353.     strcpy (msg, "\n    while auto loading \"");
  1354.     strcat (msg, argv [1]);
  1355.     strcat (msg, "\"");
  1356.     Tcl_AddErrorInfo (interp, msg);
  1357.     ckfree (msg);
  1358.  
  1359.     RemoveInProgress (interp, infoPtr, argv [1]);
  1360.     return TCL_ERROR;
  1361. }
  1362.  
  1363. /*
  1364.  *-----------------------------------------------------------------------------
  1365.  * TclLibCleanUp --
  1366.  *
  1367.  *   Release the client data area when the interpreter is deleted.
  1368.  *-----------------------------------------------------------------------------
  1369.  */
  1370. static void
  1371. TclLibCleanUp (clientData, interp)
  1372.     ClientData  clientData;
  1373.     Tcl_Interp *interp;
  1374. {
  1375.     libInfo_t      *infoPtr = (libInfo_t *) clientData;
  1376.     Tcl_HashSearch  searchCookie;
  1377.     Tcl_HashEntry  *entryPtr;
  1378.  
  1379.     entryPtr = Tcl_FirstHashEntry (&infoPtr->inProgressTbl, &searchCookie);
  1380.  
  1381.     while (entryPtr != NULL) {
  1382.         Tcl_DeleteHashEntry (entryPtr);
  1383.         entryPtr = Tcl_NextHashEntry (&searchCookie);
  1384.     }
  1385.  
  1386.     Tcl_DeleteHashTable (&infoPtr->inProgressTbl);
  1387.     Tcl_DStringFree (&infoPtr->prevPath);
  1388.     ckfree ((char *) infoPtr);
  1389. }
  1390.  
  1391. /*
  1392.  *-----------------------------------------------------------------------------
  1393.  * Tcl_InitLibrary --
  1394.  *
  1395.  *   Initialize the Tcl library facility command.
  1396.  *-----------------------------------------------------------------------------
  1397.  */
  1398. void
  1399. Tcl_InitLibrary (interp)
  1400.     Tcl_Interp *interp;
  1401. {
  1402.     libInfo_t *infoPtr;
  1403.  
  1404.     infoPtr = (libInfo_t *) ckalloc (sizeof (libInfo_t));
  1405.  
  1406.     Tcl_InitHashTable (&infoPtr->inProgressTbl, TCL_STRING_KEYS);
  1407.     infoPtr->doingIdxSearch = FALSE;
  1408.     Tcl_DStringInit (&infoPtr->prevPath);
  1409.  
  1410.     Tcl_CallWhenDeleted (interp, TclLibCleanUp, (ClientData) infoPtr);
  1411.  
  1412.     Tcl_CreateCommand (interp, "auto_load_pkg", Tcl_Auto_load_pkgCmd,
  1413.                       (ClientData) infoPtr, (void (*)()) NULL);
  1414.     Tcl_CreateCommand (interp, "auto_load", Tcl_Auto_loadCmd,
  1415.                       (ClientData) infoPtr, (void (*)()) NULL);
  1416.     Tcl_CreateCommand (interp, "loadlibindex", Tcl_LoadlibindexCmd,
  1417.                       (ClientData) infoPtr, (void (*)()) NULL);
  1418. }
  1419.  
  1420.